home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_fonts < prev    next >
Encoding:
Text File  |  1991-12-30  |  1.7 KB  |  96 lines
  1. \ Demonstrate the use of fonts in JForth
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1987 Phil Burk
  5.  
  6. include? gr.init ju:amiga_graph
  7. include? ?closebox ju:amiga_events
  8. include? get.font ju:graph_support
  9. include? value ju:value
  10.  
  11. ANEW TASK-FONTS
  12.  
  13. \ --------------------------------
  14.  
  15. \ NUL terminated font names.
  16. : "TOPAZ" 0" topaz.font" ;
  17. : "EMERALD" 0" emerald.font" ;
  18. : "RUBY" 0" ruby.font" ;
  19. : "OPAL" 0" opal.font" ;
  20. : "SAPPHIRE" 0" sapphire.font" ;
  21. : "DIAMOND" 0" diamond.font" ;
  22. : "GARNET" 0" garnet.font" ;
  23.  
  24. 0 value EMERALD
  25. 0 value GARNET
  26. 0 value OPAL
  27.  
  28. : USE.FONT   ( font -- , safe font use in case it's zero )
  29.     ?dup
  30.     IF gr.font!
  31.     ELSE ." Font not open!" cr
  32.     THEN
  33. ;
  34.  
  35. : CLOSE.FONT ( font -- , safe close )
  36.     ?dup
  37.     IF closefont()
  38.     THEN
  39. ;
  40.  
  41. : FONTS.TEST   ( -- , draw using several fonts )
  42.     gr.clear
  43.     gr.mode@  ( -- mode , save mode on stack )
  44.     JAM1 gr.mode!  ( don't clear background of characters )
  45. \
  46. \ Open fonts and store pointers to FONT structure in value
  47.     "emerald" 20 get.font -> emerald
  48.     "garnet" 16 get.font -> garnet
  49.     "opal" 12 get.font -> opal
  50. \
  51.     3 gr.color!
  52.     opal use.font
  53.     20 20 " Demonstrate Amiga Fonts" gr.xytext
  54. \
  55.     2 gr.color!
  56.     10 30 400 120 gr.rect
  57. \
  58.     1 gr.color!
  59.     emerald use.font
  60.     40 60 " ABCDefgh Emerald 20" gr.xytext
  61. \
  62.     0 gr.color!
  63.     garnet use.font
  64.     40 80 " ABCDefgh Garnet 16" gr.xytext
  65. \
  66.     3 gr.color!
  67.     opal use.font
  68.     40 100 " ABCDefgh Opal 12" gr.xytext
  69. \
  70. \ restore mode
  71.     gr.mode!
  72. ;
  73.  
  74. : FONTS.INIT  ( -- )
  75.     diskfont?
  76.     gr.opentest
  77. ;
  78.  
  79. : FONTS.TERM  ( -- )
  80.     gr.closecurw
  81.     emerald close.font
  82.     garnet close.font
  83.     opal close.font
  84. ;
  85.  
  86. : DEMO.FONTS   ( -- )
  87.     gr.init
  88.     fonts.init
  89.     fonts.test
  90.     BEGIN ?closebox UNTIL
  91.     fonts.term
  92.     gr.term
  93. ;
  94.  
  95. cr ." Enter:   DEMO.FONTS   to see fonts!" cr
  96.